38888 
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AAA AA Ht St tH A 2— 
AAA St A ————— ————— 
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L 
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ad 
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cccccccc 000000 BBBBBBBB —111111 NN NN IIIIIIIIII AAAAAA RRRRRRRR —111111— 
cccccccc 000000 BBBBBBBB 111111 NN NN TTTTITTTTIT AAAAAA RRRRRRRR 111111 

cc 0O 68 BB I] NN NN TT AA AA RR RR I] 

cc 00 00 88 8B I] NN NN TT Aa AA RR RR II 

cc 00 00 88 8B I] NNNN NN TT AB AA RR RR I] 

cc 00 00 868 BB I] NNNN N TT Aa AA RR RR I] 

cc 00 00 88888888 I] NN NN NN TT an AA RRRRRRRR Il 

cc 00 00 88888688 I] NN NN NN TT Aa AA RRRRRRRR Il 

cc 00 88 88 I] N NNNN TT AAAAAAAAAA RR RR Il 

cc 00 00 8B 8B II NN NNNN TT AAAAAAAAAA RR RR II 

cc 00 00 88 BB I] NN NN TT AS AA RR RR I] eoee 

cc BB BB I] NN NN TT AB AA RR RR I] cece 
cccccccc 000000 BBBBBBBB —111111 NN NN TT AS AA RR RR —111111— coee 
cccccccc 000000 111111 NN NN TT Aah AA RR RR 111111 cove 

L. III] SSSSSSSS 

LL IIIT] SSSSSSSS 

LL I] S$ 

LL I] SS 

LL I] SS 

LL I] SS 

LL I] SSSSSS 

LL I] SSSSSS 

LL I] SS 

LL I] SS 

LL I] SS 

LL I] SS 

LLLELLLLLL III] SSSSSSSS 

LiLLLLLLLL 111111 SSSSSSSS 
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; Detailed current edit history 


Internal routine to convert to intermediate 
Subtract intermediate temporary 

Add intermediate temporary 

Rul sialy intermediate temporary 

Divide intermediate temporary 

Compare intermediate temporary 

Convert to destination type and return 
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CORE INT ARE COBOL intermediate arithmetic 15-SEP- 8 $3: 743: +39 ted Macr 0 v04-00 Page 1 
1-01 6-SEP-1984 10:46:13 CCOBRTL.SRCJCOBINTARI.MAR;1 (1) 
-TITLE COBSINTARI COBOL intermediate arithmetic | 
“IDENT /1-019/ : File: COBINTARI -MAR Edit: $BL1019 


ne 


COPYRIGHT (c) 1978, 1980, 1982, 1984 BY 
DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASSACHUSETTS. 
ALL RIGHTS RESERVED. 


® 
fe 
® 
® 
® 
THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED 
ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE 
INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER  * 
COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY ®* 
OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY * 
TRANSFERRED. . 
® 
THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE © 
AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT * 
CORPORATION. - 
® 
x 
® 
® 
® 
® 


DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS 
SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL. 
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ett HISTORY ; Detailed current edit history ——— %; 746: 33 YCOBRTL. SREICOBINTARI MAR: 1 ” (3) 


8 9 -SBTTL HISTORY : Detailed current edit history 

3 tg ; Edit history for Version 1 of COBINTARI.MAR 

0 44 : 1-001 = ori inal, 8 h_ input and output multiplexors and CMPI. 

009 45 | MLJ et scaprei979 4 

rf 3; 1-002 - a AL ay a F —31 

9 47 ; 1-005 - une hues code | hs 394 

000 $8 3 P Storey, 07=-Jun-1 

+44 49 ; 1-004 - Aa. code for —36 

90 0 ; 1-005 - include code for 508s 

Bee 1 3 1-006 - fixed post-normal — big in COBSADDI. 

0 § s PD Gilbert, 21-Jun-197 
sit 3; 1-007 - update codes for data $38" (including COBOL Intermediate) 

00 4; R. Reichert, 11-Sept-1 
0000 5 : 1-008 = Code to return volue from all routines. MLJ 11-Sep-1979 
88 § : 1-009 - —*z 144. of $MULI due to MULP bugs with overflow. 
0000 3 : 1-010 - Delete SiSuAL from DIVI. MLJ 14-Sep-79 
0000 59 ; 1-011 = Delete COBEXPI CODE -- now in separate module COBEXP1.MAR 
0000 60 ; RKR 19-Sept-79. 
0000 61; ee - Add ates pgexTRN COBS_INTDIVZER. MLJ 05-Oct-79 
0000 6¢ 3 1-015 - Replace A with CMPP4 #0, now that ECO fixes micro-code 
0000 63; predice @ 8 Obs, WPS 16-Oct-1979 
0000 64 ; 1-014 = Change LIBSSIGNAL references to LIBSSTOP. 
0000 65 ; Cosmetic changes. RKR 21-0CT-7 
88 3 1-015 - ae gpecks for out-of-range CIT im CONVERT and FINISH. 
0000 68 ; 1-016 - Fix loss of least significant digit when borrow from MSD of 1. 
0000 9; WPS 6-Nov-1979 
0000 0 ; 1-017 - Fix detection of exponent overflow and underflow generated by 
88 4 3 the ,fecretten of to SADDI and COBSSUBI. Correct addressing 
0000 73; = special case of e Srtect tag she. — ton of * fraction 
0000 74; of alt zeroes by COBSADDI and C In this case we 
88 8 —54 exponent ~y —9 and bypass normalization of fraction. 
0000 77 ; 1-018 = Changed branch to *FINISH® in routine COBSDIVI at Label 21$: to 
0000 78 ; a RET instruction since ‘FINISH' 4 eupects the input argument to 
0000 79 ; be in the proper format, where in this case the argument is in 
0000 80 ; error and therefore was never put in the format expected by 
0000 3 ‘FINISH’. LB 15-A 
0000 ; ; 1-019 = Use general mode addressing. SBL 30-Nov-1981 

000 . 
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itt) DECLARATIONS g-SEp-} 984 93500538 UCOBRTL. SREICOBINTARI .MAR: 1 

p § -SBTTL DECLARATIONS 

p 3 -DSABL GBL 

4 0; 

0 91 ; INCLUDE FILES: 

4 38 : 

00 9 SDSCDEF 

000 G4 SINTDEF 
B38 95 

00 38 H 
838 3 ; EXTERNAL SYMBOLS: 
0000 99 -EXTRN COBSCVTWI_R8 ; Word to intermediate 
0000 100 -EXTRN COBSCVTLI_RS ; Longword to intermediate 
44 101 -EXTRN COBSCVTQI_RS ; Quadword to intermediate 
000 19 eEXTRN COBSCVTFI_R? : Floating to intermediate 
0000 10 eEXTRN COBSCVTDI_R7 3; Double to intermediate 
0000 104 -EXTRN COBSCVTPI_RO ; Packed to intermediate 
0000 105 -EXTRN COBSCVTIW_RS : Intermediate to word 
0000 196 -EXTRN COBSCVTIL_R8S : Intermediate to longword 
0000 10 eEXTRN COBSCVTIG_RB : Intermediate to quadword 
0000 108 XTRN COBSCVTIF_R7 : Intermediate to floating 
0000 109 eEXTRN COBSCVTID_R7 3: Intermediate to double 
0000 110 -EXTRN COBSCVTIP_RO : Intermediate to packed 
88 111 eEXTRN COBS_INVARG : Invalid argument 

000 8 -EXTRN COBS_INTRESOPE 
0000 11 EXTRN COBS_INTDIVZER , 
0000 114 ~EXTRN COBS_INTEXPUND : Intermediate underflow 
0000 115 -EXTRN COBS_INTEXPOVE 3; Intermediate underflow 
0000 116 -EXTRN LIBSSTOP 
0000 +117 

000 i H 

000 119 ; MACROS: 

000 120; 

000 121 

000 1 § H 

8 33 PSECT DECLARATIONS 

0000 8 -PSECT _COBSCODE PIC, SHR, LONG, EXE, NOWRT 
000 127; 
000 : 3 ; EQUATED SYMBOLS: 
00000002 508 150 INTSP_1_FRACT= 2 3; Temporary until Packed supported in MDL 

88 3; Fraction field offset 


— z3 


i 
Pehadtiggmstete artemmese, ©" TESESSISEL FESAESEE WASATE SETEONOG RB easy "0 


> The following is a packed zero. sense of this constant should be replaced 
: by immediate operands when the assembler is corrected to allow them. 

pO: -PACKED 0 

Pi: «PACKED 1 
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ped COBOL intermediate arithmetic os tb $3 07°38 penis Macro V04-00 Page 2 
1-01 CONVERT Internal routine to convert to 6=-SEP-1984 10:46:1 COBRTL.SRCJCOBINTARI .MAR; 1 (5). 
143 -SBTTL CONVERT Internal routine to convert to intermediate 
i 
146 3 Call by JSB 
147 ; RO points to descriptor eh ges = $ or SD) 
9 R1 points to output area (12 bytes) 
09 133 : Returns intermediate that has prefered sign in packed decimal mantissa. 
0 151 * 
00 136 CONVERT: 
1F 00 02 A0  8F Q00 1 CASEB DSCSB_DTYPE(RO),#0,431 ; Go to proper conversion code 
—864. 00 154 108: WORD BAD _DT=108 : O02 
OEA’ 0009 155 -WORD BAD_DT-10$ : iv 
OEA* 0008 136 WORD ett § § BU 
OEA* 000D 15 WORD BAD_DT-10$ 3 WU 
OOEA’ 86 158 eWORD BAD_DT-10$ ; 4LU 
QOEA’ 0011 159 WORD BAD_DT-10$ ; 5 QU 
OOEA* 001 160 WORD AD_DT-106$ 3 § 8 
0043° Bat 161 «WORD oon ie 3 W 
384. 91 196 WORD $-10$ : os 
0075° 0019 16 -WORD 40$-10$ ; 90 
QO8E* 0018 164 -WORD 50$-10$ : 10 F 
0098" 001D 165 -WORD 60$-10$ 3: 110 
QOEA’ 84 196 -WORD BAD_DT-10$ ; 1 FC 
QOEA’ 0021 16 «WORD BAD_DT-10$ 3: 13 OC 
OOEA' 0023 168 -WORD BAD-DT-10$ 7147 
QOEA’ 0025 169 -WORD BAD_DT-10$ 3 15 NU 
QOEA’ 0027 170 «WORD BAD_DT-10$ : 16 NL 
QOEA’ 0029 171 eWORD BAD_DT-10$ : 17 NLO 
OQOEA' 0028 He WOR BAD_DT-10$ : 18 NR 
QOEA' 002D 17 «WORD BAD_DT-10$ : 19 NRO 
QOEA’ O002F 174 WORD AD_DT-10$ Z $0 NZ 
QOA8' 0031 175 WORD 0$-10$ 3; 21 P 
QOEA’ 0033 176 «WORD BAD_DT-10$ 3 $$ 21 
QOEA’ ps8 177 -WORD BAD_DT-10$ 3 ZEM 
OOEA’ 003 178 «WORD BAD_DT-10$ 3: 24 DSC 
3— 039 179 -WORD BAD_DT-10$ 3; 25 OU 
OEA’ 0038 180 -WORD BAD_DT-10$ ; 260 
QOEA’ 003D 181 «WORD BAD_DT-10$ : 276 
QOEA’ 003f 186 eWORD BAD_DT-10$ : 28H 
OOEA' 0041 18 «WORD BAD_DT-10$ 3; 29 GC 
OEA‘ 8 —4 WORD AD_DT-10$ : 30 HC : 
ge" 4 185 WORD 0$-10$ : 31 COBOL intermediate data type 
00A7 1 —*8 1 § Rw AD_D 
OCA i ~ 
Rea ! : : Source is W 
56 D4 006A 191 208: CLRL R6 ; Assume class S 
09 O3 A0 91 4 135 CMPB BtE8S_CLASSING) ODSCEK CLASS | 50 
04 i 5 19 BNEQ 1$ 3; Branch if not class SD 
56 BA 9 05 194 CVTBL DSCSB_SCALE(RO) ,R6 ; Get scale factor 
57 AO DO 0056 195 21$:  MOVL DSCSATPOINTER(RO).R7 =; Get source address 
a 2 SA 136 MOVL R1,R8 ; Get destination address 
00000000° GF ‘ 1% JMP G*COBSCVTWI_RB : Go to conversion routine 
199 ;¢ 
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ett CONVERT Internal routine to convert to —— zuNR — SREICOBINTARI .MAR; 1 ° (8) 
6 of : Source is L 
56 3 4 § $0s: CLRL R6 3; Assume class S$ 
09 03 Ad 1 6 CMPB BsESS_CLASS CRG) -OOSCER CLASS 50 
06 1 69 BNEQ 1 3; Branch if not class SD 
2$ 8 3 9 68 CVTBL DSCS$B_SCALE(RO) ,R6 3; Get scale factor 
4 AO 6 of 31$:  MOVL DSCS$ATPOINTER(RO),R7  : Get source address 
58 51 OD 3 MOVL R1,R8 3: Get destination address 
00000000'°GF 1 8 JMP G*COBSCVTLI_R8 3; Go to conversion routine 
o7C¢ 3+ 
O07¢ : Source is Q 
56 04 «6007 ios: CLRL = R6 ; Assume class $ 
09 03 AO 1 83 CMPB DSCSB_CLASS(RO) ,ADSCSK_CLASS_SD 
04 12 008 BNEQ 41$ : Branch if not class SD 
56 08 AO 98 0084 CVTBL DSCSB_SCALE(RO) ,R6 ; Get scale factor 
57 04 a0 00 O08 41$:  MOVL  DSCSATPOINTER(RO),R7  ; Get source address 
58 51 OD 08C MOVL R1,R8 : Get destination address 
00000000'GF 1 86 JMP G*COBSCVTQI_RB : Go to conversion routine 
0095 3+ 
83 Source is F 
56 04 a0 00 0095 S0$:  MOVL DSCSA_POINTER(RO).R6 =; Get source address 
57 51 DO 0099 MOVL R1,R7 : Get destination address 
00000000'GF 17 JMP G*COBSCVTFI_R7 ; Go to conversion routine 


+ 
; Source is D 


3; Yes, 
CMPY «6s INTSW_I_EXP(RO), #INTSK_I_EXP_LO : Less than min ? 


AAA AES BE EB BAAN ANWAR NO PONOPONOPONNIND 2 2 SS IQ OO 


ANE "OOO NAUE WIN 0 OO NAU CO OONAUE 


009C 
00A 
OA 
sh 
56 04 A0 00 OOA 60$:  MOVL  DSCSA_POINTER(RO).R6 =; Get source address 
57 51 DO OOA6 MOVL R : Get destination address 
00000000'GF 17 83 JMP G*COBSCVTDI_R7 + Go to conversion routine 
OOAF 3+ 
OOAF 3; Source is P 
OOAF c= 
6 04 OOAF 70$: CLRL = R6 : Assume class $ 
09 03 40 91 0B1 CMPB BsCSB_CLASS(RO) .MDSCSK_CLASS SD 
ie bee BNEQ 1$ ; Branch if not class SD 
56 08 AO 9 0B CVTBL OSC$B_SCALE(RO) ,R6 ; Get scale factor 
7 60 3C 0088 71$ MOVZWL DSCSWTLENGTH(ROS ,R7 ; Get source Length 
58 04 A0 OD 0B MOVL  DSCSATPOINTER(ROS,R8  ; Get source address 
59 51 OD C MOVL R1,R9 3 Get destination address 
00000000'°GF 1 bce JMP G*COBSCVTPI_RY : Go to conversion routine 
be 30 
88 : Source is intermediate 
50 04 ag dO 00CB BOS:  MOVL  DSCSA_POINTER(RO),RO =; Get source address 
0063 8F 6 1 OOCF CMP JNTSUL1_EXP(ROD HINTSK_I_EXP_HI ; Bigger than max ? 
0 4 D4 BGTR 1$ over flow 
FFOD 8F 1 D6 
9 DB BLSS 1$ Yes, underflow 
81 9 7D Dp MOV (RO) +, (R1)¢ > Copy 8 bytes 
61 60 00 O0E MOVL (RO), ¢R1) : Copy 4 more bytes 


CORSINTARE —QV. intermediate arithmetic 1 —2 iß :63: 3 — ote -00 Page 7 
1 CONVERT Internal routine to convert to  6=-SEP-19 746:1 COBRTL.SRCJCOBINTARI.MAR; 1 (5) | 1 
00000000°8F pp p af sis: Reem wCORE, INTRESOPE —5— d d | 
: : Intermediate reser ed operan 
00000000 * GF 01 FB 8 CALLS #1,G*CIBSSTOP ; Signal the erro . ° 


61 ;+ 
6 : Here if not a supported data type. 


64 BaD. DT: PUSHL #COB$_INVARG : “Invalid argument List" 


Q0000000°8F Dd 
ee CALLS #1,G*CIBSSTOP 


00000000 ' GF 
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itt CONVERT Internal routine to convert to —— zuun ——— — — * (6) 1 
ore 67 -ENABL LSB : 
ore 8 -SBTTL COBSSUBI Subtract intermediate temporary 
pre 0 ;++ 
ore 4 : FUNCTIONAL DESCRIPTION: 
OFE 18 ; Accept any two supported data types as input, convert them to 
OFE 74; Intermediate, subtract them, convert the Intermediate result to the 
Oore 8 data type of the output argument, and return. 
aor 7 ; CALLING SEQUENCE: 
Bore 23 : COBSSUBI (SUBYRAHEND.rx.dx, MINUEND.rx.dx, DIFFERENCE.wx.dx) 
OOF Hi : INPUT PARAMETERS: 
OOFE es : SUBTRAHEND .rx.dx The operand to the Ce of the operator 
Bere Be : MINUEND.rx.dx The operand to the left of the operator 
OOFE 286 ; IMPLICIT INPUTS: 
OOFE 87 ; 
OOFE 88 ; NONE 
OOFE 89 ; 
Bore 9 3; OUTPUT PARAMETERS: 
OOF 32 : DIFFERENCE .wx.dx The difference of MINUEND - SUBTRAHEND 
OOFE 294 : IMPLICIT OUTPUTS: 
OOFE 95; 
OOFE 96 ; NONE 
OOFE 97 ; 
OOFE 98 ; FUNCTION VALUE: 
OOFE 99 ;: 
OOFE 00 ; NONE 
OOFE 01 ; 
OOFE O02 ; SIDE EFFECTS: 
OOFE 03 ; 
OOFE 04; NONE 
OOFE 05 ;-- 
OOFE 0 
O3FC sth] 0 ENTRY — 
98 8 *M<R2,R5,R4,R5,R6,R7,RB,RI> 
= s.. & 8 9 SUBL2 #<3*INTSK_I_LEN>,SP 3; Allocate space for 3 intermediates. 
50 04 AC 00 010 \¢ MOVL 4(AP),RO ; RO now points to SUBTRAHEND. 
51 18 AE 9E& 0107 1 MOVAB <2* INTSK_I_LEN>(SP) ,R1 ; R1 now points to stack temp SUBTRAHEND. 
FEFS 30 bie 1% BSBW CONVERT ; Convert operand. 
23 AE 01 8C 010 8 XORB2 #1 - ; Change sign of SUBTRAHEND. 
or 1 <INTSK_I_FRACT_L=1> - : 
11 18 +INTSP_I-FRACT - ; 
94 19 +<2eINTSR_1_LEN>(SP) : / 
10 11 O11 20 BRB 10$ ; Join COBSADDI code. 
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1-01 COBSADDI Add intermediate temporary 6-SEP-1984 :46:1 COBRTL EREICOBINTARI. MAR; 1 


-SBTTL COBSADDI Add intermediate temporary 


3** 
; FUNCTIONAL DESCRIPTION: 


convert them to 
Intermediate, add them, convert the Intermediate result to the data 
type of the output argument, and return. 

; CALLING SEQUENCE: 


COBSADDI (ADDEND2.rx.dx, ADDEND1.rx.dx, SUM.wx.dx) 


Accept any two supported data types as input 


114 ¢ 
114 
114 4; 
114 > 3 
114 § 3 
114 3 
114 8; 
114 9; 
9 0; 
114 14 
114 ¢ : 
ter 4: 
O14 % : INPUT PARAMETERS: 
0114 $ : ADDEND2.rx.dx The operand to the ce of the operator 
* ADDEND1.rx.dx The operand to the left of the operator 
O14 40 > IMPLICIT INPUTS: 
—* * INTSK_I_FRACT_D must be even. 
114 a4 : OUTPUT PARAMETERS: 
—* 46 : SUM. wx .dx The sum of ADDEND1 + ADDEND2 
0114 348 : IMPLICIT OUTPUTS: 
0114 49 ; 
J 
0114 353 > FUNCTION VALUE: 
0114 33 8 
Hg A ES soem 
0114 356 : SIDE EFFECTS: 
0114 357; 
0114 58 ; NONE 
bie 800° 
00000000 0114 61 oi? NE catia FRACT_D -<2 * <INTSK_I_FRACT_D / 2>>> 
0114 8 RXEnkoß INTSK_I -PRaCT _D must bé éven. 
91 $i —* 
O3FC 0114 65 ENTRY 82432 
In $6 M<R2,R5,R4,R5,R6,R7,R8, R9> 
=: eee 118 8 SUBL2 #<3eINTSK_ I “LEN, §p 3; Allocate space for 3 intermediates. 
50 04 aC 00 0119 8 MOVL : RO now points to ADDEND2. 
51 18 AE 43 11D 0 MOVAB Coe TNESK1_LEN> (SP) ,R1 3; R1 now points to stack temp ADDEND2. 
FEDE 3 121 71 BSBW CONVERT ; Convert operand, 
124 3 10$: 3; Subtract code joins here. 
50 08 AC dO 124 7 MOVL 8(AP),RO ; RO now points to ADDEND!. 
51 OC A 9E 0128 74 MOVAB = INTSK_I_LEN(SP),R1 ; R1 now points 3. stack temp ADDEND1. 
FED 30 ! ¢ o BSBW CONVERT ; Convert operand 
12F 7 
12F 78 ; 


ttre 


18 AE 
OC AE 
56 


19 
OA 


57 18 AE 
SE OC 
0086 


56 56 
57 = OC AE 


AE 


The SUBTRACT has established which number is larger; 
that is, which number has the larger exponent. 
Set up R7 and R8 accordingly. 


> e2 
MNE GW 
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COBSADDI1 Add intermediate temporary 66-SEP-1984 10:46:1 COBRTL.SRCJCOBINTARI.MAR; 1 
12F 79 ; If the value of one intermediate is zero, the result of the add is the 
: : , 3 other operand. 
12F § : If the fraction contains a zero, tne value of the intermediate temporary 
12F ; datum is zero, regardless of the magnitude of the exponent. It is only 
12F 4; convention (and hence can not be guaranteed) that if the fraction is 0 
12F 5; the exponent is 0. Since the fraction part is normalized, the only 
12F § 3 time that the low address byte of the fraction part is zero 
: : ti 5 is when the fraction part is zero. 
120F 46. 389: 
95 a F 90 TSTB <2*INTSK_I_LEND> - : Is ADDEND2 zero? 
01 3 91 +INTSP_I-FRACT (SP) : 
ie 01 8 BNEQ 2 3; If NEQ, ADDEND2 is non-zero. 
CO 0134 9 ADDL2 #1*INTSK_I_LEN,SP ; SP now points to other operand. 
11 4 , 3 BRB 30$ ; Join common code for word branch. 
$139 96 20S: $ 
95 0139 97 TSTB <1*INTSK_I_LEND> - : Is ADDEND1 zero? 
pis 98 +INTSP_I_FRACT(SP) ⸗ 
12 016 99 BNEQ 40$ ; If NEQ, ADDEND1 is non-zero. 
co Biz 9 30s ADDL2 #2*INTSK_I_LEN,SP ; SP now points to non-zero operand. 
DO 0141 $88 MOVL #1,R0 ; Indicate success — 
31 0144 40 BRW FINISH : Convert (SP) to destination and return 
0147 404 
0147 405 40S: : 
0147 406 
0147 407 ; As the fractional part of the intermediate temp is normalized, decimal 
94 $38 3 point alignment must be done before the actual add can be performed. 
0147 410; 
Bie? ai] ; Calculate difference between exponent of ADDEND1 and exponent of ADDEND2. 
A3 0147 413 SUBW3) = INT$W_I_EXP+<2*INT$K_I_LEN>(SP),- 
014A 414 INTSW_1~EXP+<1*INTSK—I-LEN>(SP) ,- 
014C 415 R6 ; R6 = el - e2 
014D 416 
19 014d 41 BLSS 80$ : If LSS, el < e2 
12 OM4F 41 BNEQ 70$ :; If NEQ, el > e2 
nt 
0151 421; At this point, exponents are equal. According to Knuth Vol 2, p 218, 
813} : 3; this has a frequency of occurrence of .47 for a radix of 10. 
DE Q151 4 MOVA <2*INTSK_I_LEN>(SP),R7 ; R7 points to ADDEND2 
9 155 4 ADOL #INTSK_I-LEN, SP 3; SP points to ADDEND!1 
1 0158 4 BRW 120% ; Go do ADD. 
158 4 
158 4 
158 4 
158 4 
158 4 
158 4 
158 4 
158 4 
15E 4 


9E 


ww 


MEW KO ODONAOULS WO 0an 


WANA ANIAIPIPOPONONINININYININD 


; el 
: Rake shift count negative. 


R6,R6 
MOVAB <1*INTSK_I_LEN>(SP) ,R7 is intermediate with larger exp. 


— — 2s 
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(1-01 COBSADDI Add intermediate temporary 6-SEP-1984 10:46:13 (CCOBRTL.SRCJCOBINTARI .MAR; 1 
58 #18 A 9 162 4 § MOVAB +S al a eee ; RB is intermediate with smaller exp. 
| 0 1 19 : BRB 90$ ; Go do scaling. 
16 4 § 80$: 3 el < e2 
57 18 AE YE 016 440 MOVAB SES INTER J LEN (SE) oR? ; R7 is intermediate with —* exp. 
58 OC AE E 195 red 908 MOVAB <i*INTSK_I_LLEN>(SP),R8 ; RB is intermediate with smaller exp. 
a7 3 
8158 445; Ensure that the absolute value of the difference between exponents 
178 —9 ; is less than or equal to INTSK_I_FRACT_D; 
FREE 8F 56 B1 $190 448 ‘ CMPW RG #-<INTSK_I_FRACT_D> ; 
03 18 0175 44 BGEA 88 : If GEQ, difference in range. 
56 13 CE 0177 450 MNEGL M#INTSK_I_FRACT_D+1,R6 ; Set diff to max negative. 
O17A. 451 958: : 
—dB8 488 
017A 454: Scale the number with the smaller exponent 
—4 $22 : into the stack temporary for the sum. 
6€ 67 B80 017A 457° MOVW INTSW_I_EXP(R7), -; Larger exponent becomes exponent 
9120 $38 INTSW_I_EXP(SP) : of stack temp SUM. 
12 00 02 48 — 3 F8 Bie 460 ASHP R6, - : Scale by the difference of exponents 
0186 461 #INTSK_I_FRACT_D -; the intermediate with 
0186 46 INTSP_T_FRACT(R8), -; the smaller exponent 
0186 46 #0, - 3 with no rounding 
0186 464 #INTSK_I_FRACT_D °3 and with standard * 
a 8* INTSP_T_FRACT(SPS 3 into the stack temp SUM. 
0186 467: Since this operation is taking place with infinite precision (only 
0186 468 ; to be truncated to 18-digits), the digits that were just shifted off 
Bike 469 ; must be considered. The effect of these digits is to contribute 
0186 470; 4a one in the low order posit ton only if 
AH + $2 : ‘ a.) the signs of the numbers being added are different 
; oan 
0186 £38 3 b.) any of the digits just shifted out were non-zero. 
ge are 
0B ABS 8D 0186 476 XORB3 <INTSK_I_FRACT_L-1>+INTSP_I_FRACT(R8),- ; Are signs different 
08 8 318° one a hema te tical” deme cali 3 or same? 
52 3 E9 b18e 135 BLBC R9,1208 ; If LBC, sign same. 
Oise at 
O18F 4 § : AS the signs are different, we have to be concerned about —82* 
Hr 485 ; por renting will only be a problem if the most Sign it leant qigit of the 
18 484 ; number with the larger exponent is a 1 (this occurs 502% of the time). 
Hr 485 ; In that case, we need a guard digit to insure INTSK_I_FRACT_D Steits 
18F 64 § 3 (OF accuracy. We will make use of the fact that INTSK"I FRACT_D is even, 
018F 487; and that therefore we have an extra digit available af INTSK_T_FRACT_D + 1. 
; : ? 3 ; Note that we have to scale BOTH numbers. 
18F 490° 
18F 491 
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Ar— —33 intermediate arithmetic 15-SEP-1984 unun nw Macro V04-00 Page 
-01 COBSADDI] Add intermediate temporary 6-SEP-1984 10:46:1 COBRTL.SRCIJCOBINTARI.MAR; 1 
02 a7 O01 91 § 49 CMPB #*XO1,INTSP_I_FRACT(R7) ; R7 is number with Larger exponent. 
18 12 3 $37 BNEQ 99$ 3 If NEQ, most significant digit not 1. 
01 =F8 5 495 ASHP #i,- : Effectively mul ttoty by 10 
is 9 49 #INTSK_I_FRACT — - ; the appropriate number of digits 
02 A 98 849 INTSP_T_FRACT(R75 ,- ; the number with the larger exponent 
99 9 49 #0,- 3; with no a 
1 9 43 #INTSK_I_FRACT_D+1,- ; with the extra digit 
02 AE INTSP_T_FRACT(SP) ; into the stack result. 
67 01 A3 9 SUBW3) 9s #1, INT$W_I_EXP(R7),- ; Larger exponenet becomes exponent 
6E A INTSW_1I_EXP(SP) : of stack result. 
56 86 A INCW R6 : Shift smaller 1 less. 
56 SOF A ASHP R6,- 3; Shift down 
A #INTSK_1I_FRACT_D,= 3; the appropriate number of digits 
02 48 12 A INTSP_T_FRACT(R8S ,- 3 the number with the smaller exponent 
0 A #0,- ; with no — 
1 A #INTSK_I_FRACT_D+1,- 3; with the extra digit 
02 47 INTSP_T_FRACT(R7) ; into the available other. 
99$: 
;  Non-zero digits that were shifted out contribute either 
; +1 or -1 depending on the sign of the number. 
59 56 02 Divw3 #2,R6,R9 : Convert from digits to bytes. 
59 6559 CVTWL «= RO, RO ; Make number of bytes a longword. 
55 56 AE MNEGW R6,R5 ; RS is number of digits shifted out. 
06 56 «EB BLBS R6,100$ ; If LBS, number of digits odd. 
0B A849 «FO BF BA BICB = #*KFO igh nibble zero. 


° = ; Make h 
<INTSK_I_FRACT_L-1>+INTSP_I_FRACT(R8)CR9J 


CMPPG =#1,P0,R5, -: Were any of the digits shifted out 
<INTSK_I_FRACT_L-1>+INTSP_I_FRACT(R8)CR9] ; non-zero? 
BEQL 120$ : IF EQL, all shifted out digits zero. 


100$: 
0B A849) 55 Fe38 01 37 


; Increase its absolute value by one. 


BLBC <INTSK_I_FRACT_L=-1>- ; If LBC, sign positive. 


0A 0B AB ED ote 
+INTS$P-I-FRACTTRB) 1108 


13. FE2D CF 01 22 SuBP4 #1,P1,FINTSK_I_FRACT_D+1.-; Contribute by negative 1. 
02 AE INTSP_I_FRACT(SP) ‘Soe 
08 11 BRB 208 ; Join common code. 
110$: : ise 
13. FE23 CF O01 20 ADDP4 #1,P1,#INTSK_I_FRACT_D+1,-; Contribute by positive 1. 
02 AE — infäe i fanris) 


at this point. all scaling and adjustments have been made. 
: The stack temp contains a number and approximate exponent. 
; R77 points to the other number. 


WN 

™~m 
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a ek et a et ee et ae ee ee a ——— — — 
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oe apa COBOL intermedi 
1-01 COBSADDI Add intermediate temporary 66-SEP-1984 10:46:1 COBRTL.SRCJCOBINTARI .MAR;1 ( 
1E1 549; Note that INTSK_I_FRACT_D+1 digit serves as a guard digit | 
1s 31 ; for both carry and borrow. 
02 A7 13. +02 AE 13 «20 HP ¢ ADDP4 wee | EE RAET BST —* Finally, the actual add is done. 
jt 3 #INTSR_T_FRACT pet. * 
IE 38 INTSP_T_FRACT(R7) : 
09 12 if 8 BNEQ 129$ 3; if nonzero, normalize 
33 B4 O1EA 28 CLRW INTSW_I — ; set exponent to zero 
12 00 F9 O1EC 5 CVILP #0, #INTSK_I FRACT D,- =; set ans at (SP) to 0 
02 AE 1EF 560 INTSP_T_FRACT (SPS ; 
= | 6 rl $3 BRB 131$ : bypass normalization 
OF 65 ; 
bie 64 ; Post-normalization. | 
1F 65 ; The most iy te Bane, digit may be anywhere, due to a carry into the 
O1F 268 3 nineteenth digit position, or a loss of significance (ex:12346-12345). 
O1F 67 ; First we must find the first non-zero digit. 
SIs 69 i298 
63 0A 00 38 O1F3 556 " — SKPC = #O,, MINTSK_I_FRACT_L,(R3); Find first non-zero byte 
61 FO + 3 atte 20) Bits #*XFO, (RID $ js high digit of byte zero? 
; Branc so 
32 D7 O1FD 258 DECL R 3; Otherwise, shift one less 
_ 3 2 OFF ere 130$ SUBL R3,R1 3; Compute byte offset of non-zero byte 
50 6241 E 0202 75 MOVAW (R2)CR13,R0 3; Compute the shift amount 
6—€ 50 Ae 8508 278 SUBW RO, INTSW_I_EXP(SP) ; Twiddle the exponent 
3 29 F8 asoe 278 ASHP RO #INTSK_I_FRACT_D+1,- : Normalize the fraction 
12 020E 580 #INTSK_f_FRACT_D,- : 
02 AE 020F 381 — INTSP_T_FRACT(SP5 : 
50 9 9 0211 38S novi #1,R0 : indicate success : 
0185 1 0214 584 BRW FINISH 3; Convert to destination and return 
0217 585 -DSABL LSB 
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wooooovovono 


9 


607 
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ee ee a ae ee ee a a a a a a a a a a a ad | oe 
SS a tt —ñ— 


0000000D 


00000008 


00000000 
09000018 
900002 
0000002F 
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COBSINTARI COBOL intermediate arithmetic -SEP-1984 23:43:5 AX/VMS Macro V04-00 14 
itt COBSMULI Multiply intermediate temporary raed at 18; 746: 33 YCOBRIL. SRCICOBINTARI .MAR; 1 —* (8) 
7 -SBTTL COBSMULI Multiply intermediate temporary 
3 -ENABL LSB 


p++ 

3; FUNCTIONAL DESCRIPTION: 
Accept any two supported data types as ete convert them to 
Intermediate, multiply them, convert the Intermediate result to the 
data type of the output argument, and return. 

CALLING SEQUENCE: 
COBSMULI (MULTIPLIER. rx.dx, MULTIPLICAND.rx.dx, PRODUCT.wx.dx) 


INPUT PARAMETERS: 


: MULTIPLIER. rx.dx The operand to the (“et of the operator 

3 MULTIPLICAND.rx.dx The operand to the left of the operator 

: IMPLICIT INPUTS: 

: NONE 

: OUTPUT PARAMETERS: 

: PRODUCT .wx.dx The product MULTIPLICAND * MULTIPLIER 

> IMPLICIT OUTPUTS: 

: NONE 

> FUNCTION VALUE: 

: NONE 

> SIDE EFFECTS: 

; NONE 

; LOCAL SYMBOLS: (To make this more readable) 

3 (Note: we use the fact that INTSK_I_FRACT_D is even) 

61 = 31° -INT$K_I_FRACT_D : # of digs for first multipl 

De s INTSK_I KPRKCT D+T = D1 # of digs for second multip 

0 = Offset from fract of first vauitioly 

; Offsets from SP 

MR = 0 : Offset for M'plier & Product int temps 

MD = MR+INTSK_I_LEN : Offset for M'cand intermediate temp 

Pri 2 MD+INTSK"I"LEN 3334 for low product 

Pr2 = Pri+cINTSK71 FRACT D/2s : Offset for high product 

SP_DECR = Pr2+<<INTSR_T_FRACT_D+D2>/2+1> ; Total to subtract from SP 
ENTRY COBS 


cMeRD j "RA, R5,R6,R7,RB,RI> 


a 


3 3 
COBSINTARI COBOL intermediate arithmetic 15-SEP-1984 23:43:5 AX/VMS Macro v04-00 Page 15 
itt COBSMULI Multiply intermediate temporary —— 0:48:43 YCOBRTL« SRCICOBINTARI .MAR; 1 ° (8) 
x -.6hCUS 19 644 SUBL2 #SP_DECR,SP i Two inter temps and a few extras 
50 04 AC § 1 645 MOVL 4(AP),RO- ; Convert aperand 1 
51 6E 64 MOVAB MR(SPS,R1 
FDDC 64 BSBW CONVERT 
2 BAC OD 6 64 MOVL (AP) ,RO 3; Convert operand 2 
1 C AE 4 A 64 MOVAB MD(SPS,R1 
FDD1 F 630 BSBW ONVERT 
1 e3¢ MULP - Calculate lower product 
11 AE OD 25 0231 65 #D1,01+INTSP_I FRACT+MD (SP) _= 
0g AE 12 0235 654 #INTSK_I_FRACT-D, INTSP_I_FRACT+MR(SP) ,- 
18 AE IF 6 8B 655 #INTSK~I-FRACT_D4D1,P Pev(SP) 
FO 8F = 8B 8 $28 BICB3S #*xF0,= orrect sign in middle of M'cand 
17 AE 0 3 637 INTSK I FRACT_D/2+INTSP_ i _FRACTSMD CSP)» - 
6 41 659 MULP - : Calculate higher product (right sign) 
OF AE 06 25 0241 660 #02, INTSP_I_FRACT+MD(SP). 
02 AE 0245 661 #WINTSK_1_FRACT_D, INTSP_1FRACT#MR(SP) ,~ 
22 AE 1 0248 66 #INTSK_I-FRACT_D+D2,Pr2( SP) 
0248 66 MOVB — Shorten lower product 
0c AS) 90 0 4B 664 <INTSK_I_FRACT_D+D2>/2(R b) 
21 AE 4 665 <INTSKIIZFRACT_D/2>4Pr 1 (SP ps 
025 66 ADDP4) = Add the two products 
18 AE 13 20 0250 66 #INTSK_I_FRACT_D+1,Pr1(S by, 
65 18 0 34 668 #INTSKTITFRACT=D+D3, ( RS) 
50 07 8 56 670 DECL RO ; Calculate amount to fiddle exponent 
50 50 65 00 €EE& 0258 671 EXTV #0,(R5),RO,RO 
50 D6 0250 ere INCL RO Amount to fiddle exponent 
6E OC AE AO O25F 67 ADDW2 INTS$W_1_EXP+MD(SP) INTSW* 1_EXP+MR (SP) 
6 SO A 0 63 674 SUBW2 RO INTS01 _EXP+MR (§P) 
50 06 8 0 66 675 SUBB2 —28X : Calculate shift amount 
65 18 50 F8 0269 677 ASHP RO,- : Shift into result 
0260 678 #INTSK_ 1_FRACT_D+D2, (RS), 
00 0260 679 ’ undin 
02 AE 12 O26e 680 #INTSK_ I_FRACT_D, INTSP_]I * ERACTSMR(SP 
50 01 po 84 oes MOVL #1,R0 : Indicate success 
0125 31 bets ret BRW FINISH : Convert to destination and return 
0277 685 -DSABL LSB 


pir l 


—* 
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COBSINTARI COBOL intermediate arithmetic 15-SEP-1984 23:43:5 AX/VMS Macro v04-00 p 1 | 
itt COBSD1 Divide jacsrandioge temporary ——— zun — — — oo (3) 
687 -SBTTL COBSDIVI Divide intermediate temporary 


~ooo 


344 
; FUNCTIONAL DESCRIPTION: 


IMPLICIT OUTPUTS: 
If the entry is COBSDIVI, then signal COBS_INTDIVZER. 
FUNCTION VALUE: ‘ 


i 
Vv 

| 91 ; 
92 ; Accept any two supported data types as input, convert them to 
935; Intermediate, divide them, convert the Intermediate result to the data 
> : type of the output argument, and return. 

0 : : CALLING SEQUENCE: 
98 : COBSDIVI (DIVISOR.rx.dx, DIVIDEND.rx.dx, QUOTIENT.wx.dx) 
9 : COBSDIVI_OSE (DIVISOR.rx.dx, DIVIDEND. rx.dx, QUOTIENT. wx.dx) 

: INPUT PARAMETERS: 

§ : DIVISOR.rx.dx The operand to the Hoty of the operator 

03 : DIVIDEND. rx.dx The operand to the left of the operator 

0 : IMPLICIT INPUTS: 

8 NONE 

8 ; OUTPUT PARAMETERS: 

02 ; QUOTIENT .wx.dx The quotient of DIVIDEND / DIVISOR 

$5 ; 

02 3 

02 3 

02 3 


; Layout of temp Storage as indexed from SP: 
; (Divisor and Dividend temps are after these 44 bytes) 


3012345678901 2345678901 2345678901 234567890123: 


So 
a a i ⏑ i BD De Nt —⏑ ⏑ ⏑ —⏑ a tt i i | 
SSS SEEDS —⏑——⏑⏑⏑⏑⏑ 


E——————— 9 OO | SS QOOOOOOCOOCO 


03 

02 NONE 

02 

8 SIDE EFFECTS: 

0 NONE 

0 aso 

5 $ 

8 3 EQUATED SYMBOLS: 
0000000 i1 = : Offset from SP 
000 8 3 8 t¢ = 2 
0000001C¢ t = 28 
8 9006 t4 = tl+6 

$5 dr = 44 : Divisor 
808 dd = dr+INT$SK_I_LEN ; Dividend 
88 ose = dd+INT$K_I_LEN 

00000045 sp_amt = oset+ 


OBSINTARI 
1-019 COBOL intermediate arithmetic LF on 
vide intermediate temporary Fabia $332 3% VAX/VS Macro v04-00 p 
Tee ; 246: COBRTL  SREICOBINTARI.MAR;1 2 (9) 
7 748 apppo00 
Ae 5) DDDd00000s 
— — i Dive devetsee 
3 seeeeeeee eereece } a ot 
— B sieeecceepegenes —2 : BICB t2+6 
7? 731 oososabsbs666605 :: c:ucaodoobbobboob. MUL, t2.ad.e3 
7? 538 : — ——— ——— SUBP4 353i, 
77 754 : eeces eee cOOccccccccce ; Cr at #26 t4+9,t4411 
; a $3? : sevcvcccceveeseeeeeesDDDDDS sive aie A 
0377 787 apoopooons.- —— i Bisa Réseastt 
0577 935 : * pe eeeorerereree : ASHP t2, (SP) 
0277 760: d= 1 sige saa" a byte 
O57, fea i Ss G Gist — —— | 
6 a 768 o = Foro * < ta (digit is zero) 
or Useful information 
ee Informati 
343 (08 ation used in this operation | 
O5FC G67? 768 “ENTRY COBSDIVI_OSE | 
50 01 98 3 2 AM<R - — 
Ree as ae 
- 0 a5 ore ENTRY cOBsbIV — 
oo ty y ph TS i es | oR54R4,R5,R6,R7.RB-RI> | 
eo 2* 4 0 8 776 rit a — 3; Get space f | 
51 2C AE OE 0 58 3 MOVL RCAP) RO. : Remember which entry point 
FD6A 30 0295 779 MOVAB dr (SPS ,R1 — Convert operand 1 (bivisor 
ee RE fe ER aii 7 eet: 
r — 
eo BBR He BRO le — 
A ee i te { Cenvert operand 2 (tient 
— —333 ASHP «#12, #INTS 
AB 7 K_I FR - ° 4 . 
_s RRA IAEAD HS | yin Pian wy rr 
$6 8 AF 790 #<{2+INTSK I_FRACT_D>,=- | 
2 1 27 3B 791 D (SP) niles — 
eae Ope 79 ive #INTSK 1_FRACT_D,~ : At 
E B88 drsINTSPTI_FRACT(SP).= 3 (d divide by Divisor 
1 t BS 79% #<12+INTSK~I_FRACT_D>,- * asia 
T:) he Ae eo br 0 B6 795 (4 Fae — 
3386 338 —— 363 
s3 et Ss 3 echatissostaacePh Ree — ASS ene tenet vignttt , 
63 (4 79 MULP #<12+1>,- SP) .R6 : gave the true sign Cans Sigttti ts) 
2 ¢5 800 SINTSK_1_FRACT_p A pros hemesinedd Apne 


2 
* 
of 


a 3 
iate arithmetic 15*SEP=1984 23:43:59 VAX/VMS P 
e intermediate temporary 6 e198 $3 4 : otis 200 age 


it C0881 


ae 
<3 
—-® 


4 246:1 COBRTL. OBINTARI.MAR;1 
61 1 (R1),° 3 (dr) 
1E ; Fe] DS INTSK_1_FRACT_D>,= 
1C AE eat : (t3) 
i 22 : SUBP4 Tea seed PRACT _9> © : ang subtrect from Dividend*10**12... 
1E Og #<12+INTSK_I_FRACT_D>,= : ees Giving a ‘remainder’ 
— 8 re ; 7 ) INTSK I eg? 3° 1 digit 4 
3; Low + s aret 
18 78 09 ASHL -#<3#8>, ; Multiply E4-by 10%#10 . 
OF AE 10 <cINTSK_1_FRACT Del>/2eth> (SP) »< 
11 AE 11 <<INTSK~1~FRACT_D+1410>/24t4-3>(SP) 
3 (by moving the sign right...) 
1 (...and zapping the old sign) 
OF AE 3 14 CLRW << INTSK_I_FRACT_D+1>/2+td>(SP) 
1 7 15 DIVP #INTSK_T_FRACT_5,- : Divide ‘remainder’ by Divisor 
2E AE 16 QrsiNtSr. 1_FRACT(SP),=- (dr) 
1D 1 aI INTSK =TLFRACT _D+14+10>,- 
06 AE 18 t4(SP),- 3 (t4) 
0B 1 #<1+10>,- 
1B AE 0 <<1241>/24t2>(SP) ; Putting it at low end of first DIVP 
20 AE 56 88 1 BISB R6,<<1241410>/24t2>(SP) ; : Put back true sign (if the 2nd DIivP 
§ : gave 0, the sign may be wrong) 
4; Temp=2 | is now a 23-digit (12+1+10) packed item equal to: 
$3 z+C ¢ Divigene x 10**12 = Divisor x Z ) / Divisor J], 
6; mere | C...J indicates integer truncation, and 
; ; (EC Dividend x 10e#12 / Divisor J / 10 J * 10) * 10*#10 


AANA AHI AIA AIA IP ⏑⏑ ⏑ ⏑ ⏑⏑ ⏑ ⏑⏑ ⏑ ⏑ ss. 
ù—— ⏑⏑⏑ ——⏑ ⏑ —⏑ ⏑ —⏑ —⏑ —⏑ —⏑— ⏑—⏑——— = 
SMPWS OOOO OPM ⏑ ⏑⏑⏑⏑———⏑ ONO NSO PS OVI SF HMO PON 


SOOOCOOCOSOSOSOOSOSOOSOSOOSOSOSOSOOSOSOSSCOSCOOSOOOCOOOOOOOOOOOOOOOOOOoOO 


50 * $3 MNEGB #4,R0 3 Shift amount (19-23) 
6 38 AE 2C AE A 0 SUBW3 INTSW_I_EXP+dr(SP), - : Calculate exponent 
31 INTSW_ I “EXP+dd(SP), - 
32 INT$W_I-~EXP(SP) 
15 AE FO 8F 93 BITB #*xFO ta (SP) : Re-normalization needed? 
046 13 34 BEQL 10$ 3 No 
6E 86 35 INCW INTSW_I_EXP(SP) : Yes. Increase the exponent 
50 7 36 DECB RO 3; Move right a Little more 
15 AE 17 50 F8 37 10$: ASHP Th a aes t2(SP),- ; Shift into Quotient 
12. 00 38 #0, #INTSK_I_FRACT_D,- 
02 AE INTSP_I SPRATT (SP) 
50 01 0 40 MOVL #1,R0™ 3; Indicate success 
0093 1 43 BRW FINISH 3; Gee, that was easy 
45 ; 
rt 3 The Divisor is zero 
OD 44 AE E8 46 208: BLBS »,21$ : Branch if entry is COBSDIVI_OSE 
000 "BF DD 47 PUSHL aeons INTDIVZER 
00000000'GF 01 FB 48 CALLS G*CIBSSTOP 
5E 38 8 9E 49 218: MOVAB dgi$P) oar ; Return dividend 
5 + 9 om Re : Indicate failure 


a 
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COBSINTARI COBOL interm SEP-19 :43:59 YAX/VMS Macro V04-00 Page 19. 
itt —XRX Compare intermediate temporary 6-SEP-1 1386 43: 746: 33 ECOBRTL. SREICOBINTARI .MAR: 1 ° (10) | 
-SBTTL COBSCMPI Compare intermediate temporary 


++ 

; FUNCTIONAL DESCRIPTION: 

Accept any two supported data types as input, convert them to 
Intermediate, compare them, and return the result of comparison 
as value. 

; CALLING SEQUENCE: 

VALUE.wl.v = COBSCMPI (SRC1.rx.dx, SRC2.rx.dx) 

; INPUT PARAMETERS: 


SRC1.rx.dx The operand to the left of the operator 
SRC2.rx.dx The operand to the right of the operator 


IMPLICIT INPUTS: 

; NONE 

; OUTPUT PARAMETERS: 
; NONE 

; IMPLICIT OUTPUTS: 
; NONE 


e 
pa 
8 
8 
8 
8 
8 


CONS S SSNS PAA AAA AAA MMIII 


FW CO OONAUE 9 ODNAUS NOAUE WN O OONOUSEW 


; FUNCTION VALUE: 
VALUE .wi.v - 


ö0000————oooA—AAOoOo]Oĩo»o—]à—àO — 


8 
8 
1 if SRC1 LSS SRC2 
3 88 0 if SRC1 EQL SRC2 
; 3 +1 if SRC1 GTR SRC2 
; 3 ; SIDE EFFECTS: 
3 9 NONE 
3 4 ‘oe 
O3FC 3 9 -ENTRY COBSCM AAR 
95 “M<R2,R5,R4, a * R7,R8,R9> 
ee. ce 96 SUBL2 #<2*IN TSK_ It >, $P ‘ Space for 2 intermediate temps 
50 O04 AC OD 9 MOVL 4(AP),RO ~ Convert operand 1 
51 OC A 43 98 MOVAB INTSK_I_LEN(SP),R1 : 
FCD 3 99 BSBW CONVERT” 3 
50 O08 AC 00 00 MOVL (AP) ,RO 3; Convert operand 2 
51 5 8 3h) MOVL SP,R1 $ 
FCC 2 §. BSBW CONVERT : 
4 ti : Case on the sign of the left operand. 
FCBD CF 01 OE AE — 9 — core {ie I_FRACT_D,INTSP_I of BACT SINTER 1_LEN(SP) ,#1,P0 
11 14 9 BGTR 7 Br if left GTR 8 
2 19 8 BLSS : Br if tet LSS 


rmediate arithmetic eis iF ot dat 4 9 et et vances Macro v04-00 Page 33, 


OBSINTARI COBOL inte 
itt) COBSCMP] Compare intermediate temporary 6-SEP- 746:1 COBRTL.SRCJCOBINTARI.MAR; 1 
cf 311 ; Here if the left operand is zero. Case on the sign of the right operand. 
FCBI CF on 02 AE 12 37 65 1 CMPPG = #WINTSK_I_FRACT_D, INTSP_I_FRACT(SP) ,#1,P0 
4314 «(034F 91 BGTR  30$ 7 Br if left EQL 0 and right GTR 
4 19 14 BLSS 40$ ; Br if left EQL 0 and right LSS 
50 Be 15 CLRL RO 3; Set “left EQL right’ 
4 2 16 RET 3; Return 
6 218 ; Here if the left operand is positive. If the right operand is nonpositive, 
6 919 ; it must be smaller. Otherwise eg the exponents and then the fractions 
6 0; if the exponents are equal. Since both: numbers are positive, the larger 
2 1 ; magnitudes correspond to larger numbers. 
FCA2 CF «001s (02 AE 3 37 0356 «9 é 10S: cupp« #INTSK_1_FRACT_D, INTSP_1_FRACT (SP) #1,P0 
38 15 5E 924 BLEQ 40$ > Br if left GTR O and right LEQ 0 
6— OC AE 81 60 925 CMPW 3s INTSW_I_EXP+INTSK_I_LEN(SP) , INTS$W_I_EXP(SP) 
3 14 64 9 § BGTR 40$ : Br if Left exp GTR right exp 
ec 19 O $6 9 BLSS 30$ ; Br if left exp LSS rrene gx? 
02 AE OE AE iF 35 0368 928 CMPP3 WINTSK_I_FRACT_D, INTSP_I FRACT#INTSK_1, LEN(SP) NTSP_I_FRACT(SP) 
2 14 0 of 929 BGTR 40$ 7 Br if left frac GTR right frac 
gf 19 037 930 BLSS 30$ ; Br if left frac LSS right frac 
0 04 0372 33! CLRL RO ; Set “left EQL right’ 
O O37s 938 2 
88 ote ; Here if the left operand is negative. If the right operand is nonnegative, 
0375 935 ; it must be larger. Otherwise, compare the exponents and then the fractions 
88 338 : if the exponents are equal. Since both numbers are negative, the Larger 
8 33 3 magnitudes correspond to smaller numbers. 
FC83 CF on oꝛ AE I2 37 0373 939 208:  CMPP4 W#INTSK_I_FRACT_D,INTSP_I_FRACT(SP) ,#1,PO 
15 18 0370 940 BGEQ > Br if left LSS 0 and right GEQ 0 
6E 0c “e B1 O037F 941 CMPW INTSW_I_EXP+INTSK_I_LEN(SP) , INTSW_]I EXP(SP) 
1 19 0383 3 BLSS 40$ ; Br if Left exp LSS right exp 
OD 14 0385 94 BGTR 30$ ; Br if left e*p GTR cient s*? 
02 AE OF AE 12 35 0387 944 CMPP3  WINTSK_I_FRACT_D, INTSP_I_FRACT+INTSK_I_LEN(SP), INTSP_I_FRACT(SP) 
09 14 O38D 945 BGTR 40$ ; Br if left frac GTR right frac 
03 19 O38F 94 BLSS 30$ ; Br if left frac LSS right frac 
50 D& 0391 94 CLRL RO : Set ‘left EQL right” 
04 8 aoe RET ; Return 
83 3 ; Here to return +1 and -1 values. 
50 01 «(CE (0394 93¢ $0$:  MNEGL #1,R0 : Set “left LSS right’ 
04 97. 95 RET ; Return : 
50 01 00 0398 954 40$: MOVL #1,R0 ; Set ‘left GTR right" 
04 0398 955 RET 3; Return 


pope rans 


0063 8F 
FFOD 8F 


02 AE 


— — — — — — — — — 
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onvert to destination type and 


~SBTTL FINISH 


1375601986 Tet at ei heeg Macro v04-00 
66-SEP-1984 10:46:1 COBRTL.SRCJCOBINTARI .MAR; 1 


Convert to destination type and return 


oO 
wn 
— 


Enter by branch with (SP) containing the intermediate result 
and 12(AP) pointing to the descriptor for the destination. 
RO contains routine status. 


TS1B INTSP_I_FRACT(SP) 
BNEQ £ 

CLRW  NTSW_1_EXP(SP) 
BRB $ 


is fraction zero ? 
no 


fru 


force exponent to zero 
—** overflow and underflow 
checks 


0-0 


* 

Check for out-of-range conditions first 

We do the check here for all destination type so that we can report 
overflow and underflow distinctly. If we allow the flow to go 
directly to various COBSCVTI_x routines, what will be reported 
is COBS_INTRESOPE (which is not correct -- we just created the 

exception and did not access it -=- creating an exception should 
distinguish between over_ and under_ flow) 


P>Prrrrrrrrrrrrrrr Powoorcooonownownono 


WODODOOODODDOOODOOOOOOOOOOOOOOOOOOOO 
09.69 09 09 09 09 09 09 NI NINN NN NNO AA AAO OOO 
NAME WR 9 OONOU EWI" o ⏑ WOO 


ö00003—oS—OOoo—à—— 


t 
C 
C 
C 
C 
C 
C 
— 
C 
C 
C 
C 
5 
5 
5 
5 
5 
5 
5 
5 
5 
A 
C 
5 
5 
A 
4 


8$: 
B1 CMPU NTSW_I_LEXP(SP), MINTSK_I_EXP_HI ; Bigger than max ? 
14 BGTR $ 3; Yes, overflow 
B1 CMPW INTSW_I_EXP(SP), MINTSK_I_EXP_LO ; Less than min ? 
19 98 BLSS 5$ 3; Yes, underflow 
0D PUSHL RO 3; Save success status 
43 ; Result now at 4(SP) 

dO 990 MOVL 12(AP) ,RO : pick up the descriptor addr. 
F 991 CASEB DSCS$B_DTYPE(RO) 40,431 

FD33 992 10$: WORD _bT=-1 “wm 

FD C 99 -WORD ®8AD_DT-10$ » + 

FD C 994 -WORD BAD_DT-10$ 3 BU 

FD C 995 -WORD BAD_DT-108 3 WU 

FD C 996 eWORD BAD_DT-10$ s 410 

FD 03C¢ 997 «WORD BAD_DT-10$ 3 5 QU 

FD CA 998 .WORD BAD-DT-10$ ; $ 8 

058° 03C 999 WORD 0$-10$ 3 W 

079" O3CE 1006 WORD $-10$ 3 8 L 

O9A* 0300 1001 -WORD 40$-10$ § Q 

008B8' 03D2 1 ¢ -WORD 50$-10$ 3 10 F 

00CD’ 0304 100 -WO 60$-10$ 3 110 

FD + 1004 WO BAD_DT-10$8 3 \¢ FC 

FD D8 1005 -WORD BAD_DT-10$ J 13 oC 

FD DA 1 89 eWORD BAD_DT-108 3: 14 7T 

FD pc 1 -WORD BAD_DT-108 ; 15 NU 

FD DE 1 8 -WORD BAD_DT-108 ; 18 NL 

FD EQ 1009 -WORD BAD_DT-10$ : 17 NLO 

FD E2 1010 «WORD BAD_DT-108 5 \8 NR 

FD —4 1011 «WORD BAD_? -10$ : 19 NRO 

FD 8 1 \¢ WORD BAD ore $ 5 $ NZ 

OODF* G3E8 101 WORD 0$-10$ ; 21 P 


—— 


RS OE ee a ee FD 


| FORE yNtaRs COBOL intermediate arithmetic a at 9 33 yeas Macro V04-00 
1-01 FINISH Convert to destination type and 6-SEP-1984 10:46:1 COBRTL.SRCIJCOBINTARI .MAR;1 
FD EA 1014 WORD BAD_DT-10$ s ¢ i 
FD EC -WORD BAD-DT-108 ; EM 
FD E -WORD BA” DT-10$ 3: 24 OSC 
FD F «WORD Bf _DT-10$ 3; 25 OU 
FD F -WORD BAL-DT-10$ : $ 0 
FD F4 «WORD BAD_DT-10$ 3 6 
FD Fe -WORD BAD_DT-10$ s 8 H 
FD F WORD 3331408 GC 
FD FA » WORD rete $ ; 30 HC 
uy " O3FC WOR 0$-10$ ; 31 COBOL intermediate data type 
FCFO 1 FE BRw BAD_DT 
rt: 
401 
401 3¢ 
401 3; CIT overflowed. 
HS 
00000000'8F DD 0401 PUSHL #COBS_INTEXPOVE : Overflow signal 
06 11 0407 BRB 6$ 3 go signal 
0409 
0409 3* 
0409 : CIT underflow 
0409 -- 
0409 Ss: 


00000000'8F DD 0409 PUSHL #COBS_INTEXPUND Underflow signal 


6$: CALLS #1,G*CIBSSTOP 3 Signal and stop. 


00000000'GF 01 FB Q40F 


öOOOOOOOOOOOOOO0OO0OO0O0OO0OO0O0 ⏑⏑⏑007 OOOO SCO OOOO SCO SO OOOO OOOCOOOOOOO 
SPP DP DDD PAP D a ⏑⏑⏑⏑ ⏑ ⏑ BS BB BEB EAA AN AAAI PIPIPNONINIPUPINIDY 2 = Ss 
NAME AN SO OO NAMEN O OD NAU EWN 9 OD NOAOU EWN OOONAUM 
Ue 


me — — — — — — — — — — — — — — — — — — — — — — — — — — — — — — — — — — — — — — — — — — — — — — — — — — — 


0416 
0416 i+ ; 
pele 3; Destination is W 
56 D4 0416 208: CLRL R6 3; Assume class S 
09 O3 AO 91 0418 CMPB DSCSB_CLASS(RO) ,ADSCSK_CLASS_SD 
07 ie 041C BNEQ 21$ : Branch if not class SD 
56 08 AO 98 041 CVTBL DSCS$B_SCALE(RO),R6 ; Get scale factor 
6 CE 042 MNEGL R6,R6 3 Negate scale factor 
57 04 AE SE 042 21$:  MOVAB 4(SP),R7 : Get source address 
58 304 AO 00 0429 MOVL DSCSA_POINTER(RO) RB ; Get destination address 
0Q0000000'GF 16 04 4 JSB G*COBSCVTIW_R8 ; Go to conversion routine 
50 8E€ 20 04 MOVL (SP)+,RO 3; Restore status 
04 83 RET : Return 
0437 3+ 
? g 3 Destination is L 
56 04 0437 3 S0s: CLRL = R6 : Assume class $ 
09 03 A 91 9 CMPB SC$B_CLASS(RO) ,ADSC$K_CLASS_SD 
0 1 4 3D 0 BNEQ : Branch if not class SD 
56 08 AO 9 43F 1 CVTBL DSCS$B_SCALE(RO) ,R6 ; Get scale factor 
56 56 E 0443 § MNEGL R6,R : Negate scale factor 
57 046 AE SE 0446 31$ MOVAB 4(SP),R7 > Get source address 
58 4 AQ DO O44A 4 MOVL DSCSA_POINTER(RO) ,RB ; Get destination address 
00000000'GF 16 044E 5 JSB G*COBSCVTIL_R8 3; Go to conversion routine 
50 —=s«aBE 0 0454 § MOVL (SP)+,RO0 3; Restore status 
4 0457 RET 3; Return 
45 3 
45 30 —— 
45 0 destinat ion is Q 


COBSINTAR 
19835 : 
5 
09 03 Ag 
56 08 AO 
56 
3 4A 
8 4A 
00000000 ' GF 
50 BE 
56 04 AE 


57 04 AD 
00000000 ' GF 
50. 8k 


56 04 AE 
57 = 04 AO 
00000000 GF 
50s BE 


56 
09 03 AO 
07 
56 08 AO 
56 


intermediate arithmetic 5-SEP=1 138¢ $343 
H Convert to Took taat ton type and 6=-SEP-1 


fSooommornr— = 


oo-9 007 OoO-07g 


:" Destination is 


Fak kde eh ee eed 


SSsesces ss 
Ooorn—oC ooouovoouNnn 


SOSSSOSOOOSOOOOOOOOOOOOOOO 
rx re 


: —— is 


922—22—2—— 
FEGOOOMOVTA 


OOIO O 
Oooocoe 
Pe oe ot et et et et et et et ek 
SVGAMMAOAOAOOOOAO 


Sess 
— — — — — — — — — — — — — — — — — — — — — — — — — — — — — — — — — — — — — — — — — — — — — — — ————— — 


ù— 9 —————22———2 2—4—⏑⏑— ⏑—O⏑———⏑ 0000 000000 09 0909 09090909 SI NINN 


MEW OOONAU SW WIN $9 OODNOAU EWN O OONOAUES WO 


2 OU 


4 


B_SCALE(RO) ,R6 


AQAOIfworow 
oY NAO —OO 


¢ 
$ 
3 
8p5,47 
C$A‘PO 
COBSCV 
P)+,RO 


:" Destination is P 


R6 
DSC$B_CLASS(RO) ,#DSCSK ciass. SD 


DSC$B_SCALE (RO) ,R6 


R7 

‘. NGTH(RO) ,R8 
BSCV 
+,RO 


: Destination is intermediate 
CRO) NTER(RO) ,RO 


“LE 
gPOLNTER<ROS, RO 
cy TIP_RO 


+39 Lenawee v04 
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Assume class 5 


$B_CLASS(RO) ,ADSCSK alas. SD 


ranch if not class SD 
Get negative of scale factor 


Get source address 

Get destination address 
Go to conversion routine 
Restore status 

Return 


; Get source address 

; Get destination address 
; Go to conversion routine 
; Restore status 

; Return 


; Get source address 

; Get destination address 
; Go to conversion routine 
; Restore status 

; Return 


ssume class S$ 


; Branch if not class SD 
Get negative of scale factor 


Get source address 

Get destination length 
Get destination address 
Go to conversion routine 
Restore status 

Return 


Get destination address 
Move 8 bytes 

Move 4 more bytes 
Restore status 

Return 


| 
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COBSINTARI COBOL intermediate arithmetic 15-SEP-1984 23:43:5 'AX/VMS v04-00 Page 24 
Symbol table ——— ica: 3 YCOBRTL. § L.S OBINTARI .MAR;1 ° df) 

13 = 
O000T 4 F Lis 88 ti = 90000006 
1 RG 
Reeerere x 
eeeeeere x 
reereere x 
eeereeee x 
eeereeee x 0 
eeereeee x 4 
eeereare x 8 
eeekeere K 0 
geeeeere x 8 
reeteeeee x 
eeeeeeee x 8 
geerenee x 0 
0000027E RG 0 
00000277 RG 0 
00000217 RG 0 
QOOOOOFE RG 0 
Reeeeeer x 00 
geerener x 00 
eereeeee x 00 
eeeeeeee x 00 
geereree 4 00 
00000002 R 02 
= 00000000 
= sa id 
= 000000 
00000282 R 02 
= 00000 sf 
= 00000004 
= 00000003 
= Woogoßz 
= 0000000 
= 00000009 
= 00000000 
94 4 8445 R 02 
= sp sess: 
= FFFFFF9OD 
= —W86 
= 0000000A 
= 0000000C 
= ; 0000 
= 000000 
ueeee tes x 00 
000000C 


huun 
Ses 
Ss 
oO 


nO 


20 
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COBOL intermediate arithmetic 15- 


| COBSINTARI 5 Hae 9 Tet eet —2 
— synopsis 6-SEP-1984 10:46:1 COBRT 
teow anr mesos ores +t 
! Psect synopsis ! 
$eeons cre reser eo eee} 
PSECT name Allocation PSECT No. Attributes 
- ABS . W88 ( 4 9 ( 0.) NOPIC USR CON ABS LCL N 
SABSS 0000000 ( -) QO1¢ #1.) NOPIC USR CON ABS LCL N 
_COBSCODE 00000401 ( 1233.) 02 ¢ 2.) PIC USR CON REL LCL 


tm rm ne Oe ee Re Oe + 


! Performance indicators ! 


— er ease mre meaaca wwomacaan + 


Phase Page faults CPU Time Elapsed Time 
Initialization 31 00:00: 8-06 00:00:0 19 
Command processing 118 00:00: * 00:00:03.3 
Pass 1 188 99 282: 84 00:00:1 +06 
Symbol table sort 0 BB: set 00:00:00.4 
Pass 2 196 0:00:01.51 00:00:06.13 
Symbol table output 7 88 00:00: 67 00:00:00.05 
Psect synopsis output 3 0:00:00.01 00:00:00.01 
Cross-reference output 0 bs Bo 00:00:00.00 
Assembler run totals 547 00:00:05.0 00:00:27.15 


The working set Limit was 1500 pages. 

24129 bytes (48 pages) of virtual memory were used to buffer the intermediate code. 

There were 20 pages of symbol table space allocated to hold 188 non-local and 52 local symbols. 
1125 source Lines were read in Pass 1, producing 30 object records in Pass 2. 

9 pages of virtual memory were used to define 8 macros. 


Pero wooewo wooo oooooe woceeee + 
! Macro Library statistics ! 


pow em ew me wa mee Te RR + 


Macros defined 


Macro Library name 


-$255$DUA28: CCOBRTL .OBJJCOBRTL .MLB; 1 1 
$255$DUA28: CSYSLIBISTARLET.MLB;2 4 
TOTALS (all Libraries) 5 


203 GETS were required to define 5 macros. 
There were no errors, warnings or information messages. 


OSH 
OSHR 


S$ Macro v04-00 Page $3 
L.SRCIJCOBINTARI .MAR; 1 (11) 


R NOEXE NORD NOWRT NOVEC BYTE 
EXE RD 


WRT NOVEC BYTE 
EXE RD NOWRT NOVEC LONG 


MACRO/ENABLE =SUPPRESS1ON/D1 SABLE= (GLOBAL, TRACEBACK) /LIS=L1S$:COBINTARI/OBJ=OBJ$:COBINTARI MSRC$:COBINTARI/UPDATE=(ENHS:COBINTARI)*L1 | 


IGI ION 
ONF RY 


N63 AH-BT13A-SE | D 


7 
A 


TAL EQUIPMENT CORPORA 
VAX/VMS V4.0 ID T 
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ENTIAL AND PROPRIE 


